-- {-# ExistentialQuantification #-}

module Utility where

import Data.Maybe (fromMaybe, isNothing)
import Data.List (minimumBy)
import Data.Ord (comparing)
import Data.Function (on)
import Debug.Trace (trace)
import Data.Function (fix)

default ()

-- *Enum utils

-- |a list of each constructor in a 'Bounded' 'Enum' in successor order
--
-- call like @list::[TypeName]@ or @list `asTypeOf` [TypeName]@
list :: (Enum a, Bounded a) => [a]
list = [minBound .. maxBound]

-- |indices of 'Enum' members
enumInds :: Enum a => [a]
                   -> [Int]
enumInds = map fromEnum

-- |number of steps up from 1st to 2nd arg in 'Enum' list
enumDiff :: Enum a => a
                   -> a
                   -> Int
enumDiff = subtract `on` fromEnum

-- |cardinality of a 'Bounded' 'Enum' type
numElems :: (Enum a, Bounded a) => a
                                -> Int
numElems x = length (list `asTypeOf` [x])

-- *Maybe utils

-- |un'Maybe'ize a list, error with specified message if it contains any 'Nothing's
--  won't error until a 'Nothing' is actually evaluated, so we are infinite list safe
cleanMaybes :: String
            -> [Maybe a]
            -> [a]
cleanMaybes s = map $ fromMaybe (error s)

-- |apply 'Just' to all members of a list
maybeize :: [a]
         -> [Maybe a]
maybeize = map Just

-- *List utils

-- |'Just' +1 if list monotone ascending, 'Just' -1 if monotone descending, 'Just' 0 if constant (or less than 2 elements), and 'Nothing' if not monotonic
--
--  can't terminate if list is monotonic infinite.  otherwise efficiently fails asap.
monotonic :: Ord a => [a]
                   -> Maybe Int
monotonic xs | all (== EQ) cs   = Just 0
             | allIn [LT,EQ] cs = Just 1
             | allIn [GT,EQ] cs = Just (-1)
             | otherwise        = Nothing
             where cs = case mapPairs compare xs of Nothing -> []
                                                    Just zs -> zs

-- |check if all elements of 2nd list are members of 1st list
--
--  can't terminate when 2nd list is infinite list of members of 1st list.  otherwise efficiently fails asap.
allIn :: Eq a => [a]
              -> [a]
              -> Bool
allIn = all . (flip elem)

-- |if list contains n >= 2 members, return 'Just' list of n-1 results of applying f to each sequential pair, otherwise 'Nothing'
mapPairs :: (a -> a -> b)
         -> [a]
         -> Maybe [b]
mapPairs f xs@(_:_:_) = Just $ zipWith f (init xs) (tail xs)
mapPairs _ _          = Nothing

-- |as mapPairs, but works for any list (and is thus not 'Maybe'ized), by wrapping the pair for the final element around to the head
mapPairsWrap :: (a -> a -> b)
             -> [a]
             -> [b]
mapPairsWrap _ []       = []
mapPairsWrap f xs@(x:_) = good
    where (Just good) = mapPairs f (xs ++ [x]) -- can't be Nothing cuz we're constructing the list to contain at least one pair

-- |return pair with lowest abs key in an assoc list
best :: Real a => [(a, b)]
               -> (a, b)
best = minimumBy (comparing $ abs . fst)

-- |list of 'Just' the indices of the first elements in the 1st list that match the elements in the 2nd list, in order of the 2nd list
--
--  'Nothing' for elements in the 2nd list that aren't in the 1st list
--
--  ex: @find \"abcdea\" \"ffbagdd\" = [Nothing,Nothing,Just 1,Just 0,Nothing,Just 3,Just 3]@
--
--  compare: Data.List.elemIndex, which uses a comprehension
find :: Eq a => [a]
             -> [a]
             -> [Maybe Int]
find = map. (flip lookup) . (flip zip) [0..]

-- |list of 'Just' elements in the 1st list at indices specified by the 2nd list
--
--  'Nothing' for indices in the 2nd list that are 'Nothing', too large, or negative
--
--  ex: @index \"abcde\" [Just 1,Nothing,Just 0,Just -9,Just 10] = [Just 'b',Nothing,Just 'a',Nothing,Nothing]@
index :: [a]
      -> [Maybe Int]
      -> [Maybe a]
-- would like to also accept scalar as 2nd arg, but this seems to be a pain (see experiments in Vectorable.hs and fmapped.hs -- i think applicative functors will help here...)
index = map . safeDoubleBang

-- |'Maybe'ize !! to avoid runtime exception for indices that are 'Nothing', too large, or negative
--
--  should use Arrays instead of lists if doing a lot of random access
safeDoubleBang :: [a]
               -> Maybe Int
               -> Maybe a
safeDoubleBang _ Nothing = Nothing
safeDoubleBang xs (Just n) | n >= 0 && atLeast (n + 1) xs = Just (xs !! n)
                           | otherwise                    = Nothing

-- | safe efficient minimum list length check
--
-- stolen from <http://www.haskell.org/haskellwiki/Things_to_avoid>
atLeast :: Int
        -> [a]
        -> Bool
atLeast n = not . null . drop (n-1)
--atLeast = (not .) . ((null .) . (drop . (subtract 1))) -- pointfree by currying (.) seems unwise

-- |search for first predicate success in a list of infinite lists
bredthFirst :: (a -> Bool) -> [[a]] -> a
bredthFirst f xs | null found = bredthFirst f (map tail xs)
                 | otherwise  = head found
                 where found  = filter f (map head xs)

-- |find the element with the lowest index in a list of lists that satisfies a predicate
findFirstAcross :: (a -> Bool)
                -> [[a]]
                -> Maybe (a, Int, Int) -- ^(successful element, list index, position index)
-- wow, this is entirely out of hand -- must be some dramatically simpler way...
-- see how much simpler bredthFirst is -- doesn't have to worry about empty lists, remembering match index, etc.
findFirstAcross f xs = ffa_help f (zip [0..] xs) 0

ffa_help :: (a -> Bool)
         -> [(Int, [a])]
         -> Int
         -> Maybe (a, Int, Int)
ffa_help f xs posInd | all (null . snd) xs = Nothing
                     | null found          = ffa_help f tails $ (posInd + 1)
                     | otherwise           = Just (head found, head listInd, posInd)
                     where (found, listInd) = dig f heads
                           (heads, tails)   = headsTails xs

-- |input is a predicate and a list of integers paired with (potentially empty) lists.  from the lists, collect the heads that pass the predicate, together with a list of the integer labels from the successful lists.
-- |doesn't seem helpful to use Data.List.findIndices
dig :: (a -> Bool)
    -> [(Int, [a])]
    -> ([a],[Int])
dig _        []  = ([],[])
dig f ((i,xs):y) | (not $ null xs) && (f x) = (x:ys,i:yi)
                 | otherwise                = (ys,yi)
                 where (ys,yi) = dig f y
                       x       = head xs

-- |input is a list of integers paired with lists.  collect the heads of the lists (or empties for empties) into a list of pairs with the same integer labels.  similarly for the tails.
headsTails ::  [(Int, [a])]
           -> ([(Int, [a])], [(Int, [a])])
headsTails         []  = (             []  ,               [])
headsTails ((i,xs):ys) = ((i,hx):(fst rec) , (i,tx):(snd rec))
    where rec      = headsTails ys
          (hx, tx) = if   null xs
                     then ([],[])
                     else ([head xs], tail xs)

-- |predicate filter on an assoc list
filtByKey :: (a -> Bool)
          -> [(a, b)]
          -> [b]
filtByKey f pairs = [y | (x,y) <- pairs, f x ] -- comprehensions considered overly imperitive in style, but i'm just trying it out
--                = map snd $ filter (f . fst)  -- equivalent noncomprehension pointfrees pairs

-- |like map, but return a list of pairs (fx, x) that preserves the domain
zipMap :: (a -> b)
       -> [a]
       -> [(b,a)]
zipMap f xs = zip (map f xs) xs

-- |take two functions that take lists to lists, apply them to a list of pairs
zipInto :: ([a] -> [b])
        -> ([c] -> [d])
        -> [(a,c)]
        -> [(b,d)]
zipInto f g xs = zip (f ys) (g zs)
    where (ys,zs) = unzip xs

-- |take two functions and a list of pairs, return a list of pairs of results of applications of the functions
pairMap :: (a->b)
        -> (c->d)
        -> [(a,c)]
        -> [(b,d)]
pairMap f g xs = [(f y,g z) | (y,z) <- xs]
-- comprehension preferred in this case
--               = zip (map f ys) (map g zs)
--                    where (ys,zs) = unzip xs

-- |bredth first interleaving of a list of infinite lists
--  will error if encounters the end of any list!
--  fix (the Y combinator) allows creation of recursive lambdas (http://en.wikibooks.org/wiki/Haskell/Fix_and_recursion)
interleave :: [[x]]
           -> [x]
interleave = fix (\f x -> (map head x) ++ f (map tail x))

-- *math

-- |divide two numbers and return the nearest whole integer result, plus the fractional error
--  similar to Prelude.properFraction, but minimizes magnitude of error
genQuotRem :: (Real a, Integral b, RealFrac c) => a
                                       -> a
                                       -> (b, c)
genQuotRem x y = (q, (fromRational r) - (fromIntegral q))
    where q = round r
          r = ((/) `on` toRational) x y

-- |cumulative sum
cumsum :: Num a => [a]
                -> [a]
cumsum = scanl1 (+)

-- any way to clean this up?
-- idea is to take some range, which might be going up or down, and preserve its direction, but just extend it to include n
includeZero :: (Eq a, Ord a) => a
                             -> a
                             -> a
                             -> (a,a)
includeZero x y n | lo > n    = if x == lo then (n,y) else (x,n)
                  | hi < n    = if x == hi then (n,y) else (x,n)
                  | otherwise = (x,y)
    where lo = min x y
          hi = max x y

between :: Ord a => a
                 -> a
                 -> a
                 -> Bool
between i j x = not $ isNothing $ monotonic [i, x, j]

-- *misc

traceIt :: Show a => a -> a
traceIt x = trace (show x ++ "\n\n") x

-- |list wrapper to facilitate a show that inserts indices before and newlines after each member rather than the default [,,,,] format
data L a = L [a]
instance Show a => Show (L a) where
    show (L x) = concat $ map (\(i,y) -> show i ++ ": " ++ show y ++ "\n") $ zip ([0..]::[Int]) x
